home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 010 / scoutfun.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1985-10-05  |  7.4 KB  |  227 lines
  1. 10  KEY OFF:LOCATE ,,0:SCREEN 0,0,0
  2. 110  FOR A=1 TO 9:ON KEY(A) GOSUB 790:KEY(A) ON:NEXT
  3. 120  KEY(10) ON:DEF SEG:POKE 106,0
  4. 130  ON KEY(10) GOSUB 1600
  5. 140  DEFINT A-T
  6. 150  DEFSTR U,W,Z:DIM WORD(100),A(100),USED(27)
  7. 160  GOSUB 1980
  8. 170  FOR B=0 TO 100
  9. 180      READ WORD(B)
  10. 190  NEXT
  11. 200  GOSUB 1320
  12. 205  CLS:LOCATE 5,10:INPUT "ENTER SCOUTMASTERS NAME   ", N$
  13. 207  LOCATE 8,15:INPUT "TROOP NUMBER ", O$
  14. 210  CLS:LOCATE 1,33:PRINT "BOY SCOUTS
  15. 220  FOR C=1 TO 27:USED(C)="":NEXT
  16. 230  A=A+1
  17. 240  CHANCE=0
  18. 250     RANDOMIZE(VAL(RIGHT$(TIME$,2)))
  19. 260  B=RND(1)*100:A(A)=B
  20. 270  FOR C=0 TO A-1:IF A(C)=B THEN 260 ELSE NEXT
  21. 280  L=LEN(WORD(B)):WORD=SPACE$(L):WH1=SPACE$(L):X=1
  22. 290  LOCATE 10,30:FOR C=1 TO L:IF MID$(WORD,C,1)=" " THEN PRINT "- "; ELSE PRINT MID$(WORD,C,1)" ";
  23. 300  NEXT
  24. 310  XLIN=CSRLIN:YPOS=POS(0):GOSUB 1650
  25. 320  COLOR 0,7
  26. 330  LOCATE 4,23:PRINT " These Are The Letters You Have Used "
  27. 340  COLOR 3,0
  28. 350  LOCATE 6,25:FOR C=1 TO X:PRINT USED(C)" ";:NEXT
  29. 360  LOCATE 8,30:PRINT "This Is Your Word:
  30. 370  COLOR 15,0:LOCATE 12,28,1:PRINT "Please Guess A Letter";:COLOR 3,0:GOSUB 1550
  31. 380  IF W=>"A" AND W=<"Z" THEN 390 ELSE 610
  32. 390  FOR G=1 TO X:IF W=USED(G) THEN 630 ELSE NEXT
  33. 400  LOCATE 10,28,0
  34. 410  FLAG=0
  35. 420  FOR G=1 TO L:IF W=MID$(WORD(B),G,1) THEN FLAG=1:LOCATE 10,28+2*G:PRINT MID$(WORD(B),G,1);:MID$(WORD,G,1)=MID$(WORD(B),G,1):IF WORD=WORD(B) THEN 520
  36. 430  NEXT
  37. 440  USED(X)=W:X=X+1:IF FLAG=0 THEN GOSUB 640:IF CHANCE=10 THEN 560 ELSE 290
  38. 450  FLAG=0:LOCATE 12,1:PRINT SPC(79):COLOR 15,0
  39. 455  LOCATE 24,20:PRINT "Enter Your Guess And Then Strike Enter Key";
  40. 460  LOCATE 21,20,1:PRINT "What Do You Think The Word Is, Scout? ";:GOSUB 2130
  41. 470  WH=WA
  42. 480  COLOR 3,0:IF WH=WORD(B) THEN 520
  43. 490  LOCATE 24,1:PRINT SPC(79);:LOCATE 22,30:PRINT "Nice Try. But No Merit Badge  !!"
  44. 500  LOCATE 21,1:PRINT STRING$(80,32);:FOR G=1 TO 2000:NEXT:LOCATE 22,1:PRINT        STRING$(80,32);:GOTO 290
  45. 510  REM*****HAIL TO THE CHIEF************
  46. 520  IF Z="N" OR Z="n" THEN GOTO 550
  47. 525  PLAY "T140"+"MN"+"MB"
  48. 530  PLAY "MB O2"+"G4. A4 B8 O3 C4.O2 B4 A8 G4 A8 G4 E8 D4. C4."
  49. 540  PLAY "MB O2"+"G4. A4 B8 O3 C4.O2 B4 A8 G4 A8 G4 E8 D4. C4."
  50. 550  GOSUB 1690:LOCATE 23,19:PRINT"You Saved Mr. SCOUTMASTER  In"X-1" Tries"
  51. 560  COLOR 0,7
  52. 570  LOCATE 25,20:PRINT" Would You Like To Try Another Word? <Y/N> ";
  53. 580  COLOR 3,0
  54. 590  GOSUB 1550:IF W="Y" THEN 210 ELSE IF W<>"N" THEN 590
  55. 600  CLS:LOCATE 10,22:PRINT "Thank You For Playing H A N G M A N":GOTO 1680
  56. 610  LOCATE 12,23:PRINT "Invalid REPLY. Please Try Again.";
  57. 620  FOR G=1 TO 4500:NEXT:LOCATE 12,1:PRINT SPC(70):GOTO 370
  58. 630  LOCATE 12,16:PRINT"You Already Used That Letter. Please Try Again.":GOTO 620
  59. 640  CHANCE=CHANCE+1:CLS:COLOR 15,0
  60. 650  ON CHANCE GOTO 760,750,740,730,720,710,700,690,680
  61. 660  GOSUB 1230
  62. 670  GOSUB 980
  63. 680  GOSUB 970
  64. 690  GOSUB 1090
  65. 700  GOSUB 1080
  66. 710  GOSUB 1040
  67. 720  GOSUB 1000
  68. 730  GOSUB 960
  69. 740  GOSUB 950
  70. 750  GOSUB 880
  71. 760  GOSUB 810:COLOR 3,0
  72. 770  IF CHANCE=10 THEN GOSUB 1100
  73. 780  FOR C=1 TO 3500:NEXT:IF CHANCE<10 THEN CLS
  74. 790  RETURN
  75. 800  REM**** HEAD ****
  76. 810  COLOR 15,0:LOCATE 3,35:PRINT "VARPTRSOUNDSOUNDSOUNDSOUNDSOUNDCOLOR"
  77. 820  LOCATE 4,35:PRINT    "CALL "CHR$(1)" "CHR$(1)" CALL"
  78. 830  LOCATE 5,35:PRINT            "CALL  -  CALL"
  79. 840  LOCATE 6,35:PRINT            "CALL KEYTHENCLOSE CALL"
  80. 850  LOCATE 7,35:PRINT            "CLSSOUNDSOUNDSOUNDSOUNDSOUND'"
  81. 860  COLOR 3,0:RETURN
  82. 870  REM**** UPPER TORSO ****
  83. 880  COLOR 2,0:LOCATE 8,33:PRINT "POINTPOINTPOINTPOINTCSRLINCSRLINCSRLINPOINTPOINTPOINTPOINT"
  84. 890  LOCATE 9,32:PRINT          "LINESCOUTMASTERWHILE"
  85. 895  LOCATE 10,50:PRINT N$
  86. 897  LOCATE 11,50:PRINT "TROOP", O$
  87. 900  FOR C=10 TO 13:LOCATE C,35:PRINT STRING$(7,176):NEXT
  88. 910  LOCATE 14,35:PRINT            "LINELINELINELINELINELINELINE"
  89. 920  LOCATE 15,36:PRINT             "CSRLINBSACSRLIN"
  90. 930  COLOR 3,0:RETURN
  91. 940  REM**** LEGS ****
  92. 950  COLOR 5,0:FOR C=16 TO 19:LOCATE C,36:PRINT STRING$(2,219):NEXT:RETURN
  93. 960  COLOR 5,0:FOR C=16 TO 19:LOCATE C,39:PRINT STRING$(2,219):NEXT:RETURN
  94. 970  COLOR 4,0:LOCATE 20,39:PRINT STRING$(4,176):COLOR 3,0:RETURN
  95. 980  COLOR 4,0:LOCATE 20,34:PRINT STRING$(4,176):COLOR 3,0:RETURN
  96. 990  REM**** ARMS ****
  97. 1000  COLOR 14,0:LOCATE 10,31:PRINT "WHILEWHILE"
  98. 1010  LOCATE 11,30:PRINT "WHILEWHILE"
  99. 1020  LOCATE 12,29:PRINT "WHILEWHILE"
  100. 1030  COLOR 3,0:RETURN
  101. 1040  COLOR 14,0:LOCATE 10,44:PRINT "WHILEWHILE"
  102. 1050  LOCATE 11,45:PRINT "WHILEWHILE"
  103. 1060  LOCATE 12,46:PRINT "WHILEWHILE"
  104. 1070  COLOR 3,0:RETURN
  105. 1080  COLOR 7,0:LOCATE 13,28:PRINT "CSRLINCSRLINCSRLIN":COLOR 3,0:RETURN
  106. 1090  COLOR 7,0:LOCATE 13,46:PRINT "CSRLINCSRLINCSRLIN":COLOR 3,0:RETURN
  107. 1100  LOCATE 2,38:PRINT "OPEN"
  108. 1110  LOCATE 3,38:PRINT "USR"
  109. 1120  REM******TAPS***********
  110. 1130  IF Z="N" OR Z="n" THEN GOTO 1180
  111. 1135  PLAY "T120"+"MN"+"MB"
  112. 1140  PLAY "O3L8C.L16C"+"L2F.L8C.L16F"
  113. 1150  PLAY "L2A.L8C.L16F"+"L4A"+"L8C."+"L16F"+"L4A"+"L8C."+"L16F"+"L2A."
  114. 1160  PLAY "O3"+"L8F.L16A"+"ML"+"O4L2C"+"MN"+"O3L4AL4FL2C."
  115. 1170  PLAY "O3L8C.L16C"+"ML"+"L1F"+"MN"+"L4F"
  116. 1180  FOR C=1 TO 1200:NEXT
  117. 1200  LOCATE 21,31:PRINT SPC(20)
  118. 1210  RETURN
  119. 1220  REM**** GALLOWS ****
  120. 1230  LOCATE 1,15:PRINT STRING$(25,178)
  121. 1240  LOCATE 2,15:PRINT STRING$(5,178)
  122. 1250  FOR C=3 TO 20:LOCATE C,15:PRINT STRING$(4,178):NEXT
  123. 1260  LOCATE 21,5:PRINT STRING$(40,178)
  124. 1270  FOR C=22 TO 23:LOCATE C,5:PRINT STRING$(4,178)SPC(15)STRING$(4,178)
  125. 1280  NEXT:COLOR 3,0:RETURN
  126. 1290  DATA CUB,SCOUTER,GAME,IGLOO,KNIFE,PATROL,FUN,LIGHT,CANOE,TREE,HIKE,CAMPING,THRIFTY,CAMPMASTER,CUBS,CABIN,PATROL,BICYCLE,CLEAN,FRIENDS,FIRST,AWARD,SCOUTMASTER,POWWOWS,DANGEROUS,FIREPLACE,EQUIPMENT,AWARDS,PLAY,BASEBALL,TENT,PATROLLEADER,PROGRAM,MATCH
  127. 1300  DATA MUSIC,EXPLORE,COMPUTER,CAMPER,CHIMPANZEE,WATER,CABIN,NATURE,AUTOMOBILE,ANIMAL,LAMP,LIGHT,FREEZER,FRY,SKILL,ERRONEOUSLY,KLONDIKE,AWARD,HIGHWAY,PATROL,CAN,BIRDS,FLY,JAMBOREE,SAILBOAT,TREE,BUGLER,AWARD,HOTEL,COOKS,SWIM,OCEAN,OWLS
  128. 1310  DATA STINK,ICE,SNOW,SLEEP,FIRE,BOYS,ZOOMS,ESCAPE,EAT,RACER,BEAR,JUMP,COOLER,MAPPING,SPORT,MAILBOX,SCOUT,THUNDER,LIGHTNING,RAIN,ADVENTURE,DEN,TOWER,PHYSICALLY,LIFE,TUCKAHOE,CIRCUS,SCARY,BADGES,KIND,HELPFUL,CHURCH,CLEAN,STREET
  129. 1320  CLS:COLOR 15,0
  130. 1330  LOCATE 1,1:PRINT CHR$(201)STRING$(78,205)CHR$(187)
  131. 1340  FOR A=2 TO 22
  132. 1350     LOCATE A,1:PRINT CHR$(186);:LOCATE A,80:PRINT CHR$(186);
  133. 1360  NEXT
  134. 1370  LOCATE 23,1:PRINT CHR$(200)STRING$(78,205)CHR$(188);
  135. 1380  LOCATE 2,29:PRINT "SCOUTMASTER HANGMAN"
  136. 1385  LOCATE 9,24:PRINT "Do you want sound? <Y/N>  ":GOSUB 1595
  137. 1390  LOCATE 9,24:PRINT "Would You Like Instructions? <Y/N>  ":COLOR 3,0
  138. 1400  GOSUB 1550:IF W="N" OR W="n" THEN RETURN ELSE IF W<>"Y" AND W<>"y" THEN 1400
  139. 1410  LOCATE 4,17:PRINT "In SCOUTMASTER HANGMAN I will choose a  secret
  140. 1420  LOCATE 5,17:PRINT "word. It is your problem to guess this word in
  141. 1430  LOCATE 6,17:PRINT "TEN tries or less. You do this by guessing one
  142. 1440  LOCATE 7,17:PRINT "letter at a time. If the letter that you guess
  143. 1450  LOCATE 8,17:PRINT "is in the word,  I will put it in the position
  144. 1460  LOCATE 9,17:PRINT "that it belongs,  and allow you to guess  what
  145. 1470  LOCATE 10,17:PRINT"the secret word is. If the letter you guess is
  146. 1480  LOCATE 11,17:PRINT"not part of the secret  word,  another part of
  147. 1490  LOCATE 12,17:PRINT"the Scoutmaster will be added. You have 10 bad
  148. 1500  LOCATE 13,17:PRINT"guesses  before  your Scoutmaster is hung. If
  149. 1510  LOCATE 14,17:PRINT"you are able to guess the secret word,  your
  150. 1520  LOCATE 15,17:PRINT"Scoutmaster goes free. Its up to you!
  151. 1530  LOCATE 18,29:PRINT"GOOD LUCK AND HAVE FUN, SCOUT
  152. 1540  COLOR 15,0:LOCATE 25,27:PRINT"Strike Any Key To Continue";:COLOR 3,0
  153. 1550  W=INKEY$:IF W<>"" THEN 1550
  154. 1560  W=INKEY$:IF W="" THEN 1560
  155. 1570  IF W<"a" OR W>"z" THEN 1590
  156. 1580  W=CHR$(ASC(W)-32)
  157. 1590  RETURN
  158. 1595  Z=INKEY$:IF Z<>"" THEN 1595
  159. 1596  Z=INKEY$:IF Z="" THEN 1596
  160. 1597  Z=CHR$(ASC(Z))
  161. 1598  RETURN
  162. 1600  KEY(10) OFF:XLIN=CSRLIN:YPOS=POS(0)
  163. 1610  LOCATE 25,1:PRINT SPC(79);
  164. 1620  LOCATE 25,23:COLOR 15,0:PRINT "Do You Wish To Leave This Game? <Y/N>";:COLOR 3,0
  165. 1630  GOSUB 1550:IF W<>"N" THEN 1670
  166. 1640  W="":IF INKEY$<>"" THEN 1640
  167. 1650  LOCATE 25,1:PRINT SPC(79);:LOCATE 25,25:COLOR 0,7:PRINT " Strike <F10> To Leave This Game ";:COLOR 3,0
  168. 1660  LOCATE XLIN,YPOS:KEY(10) ON:RETURN
  169. 1670  IF W<>"Y" THEN 1620
  170. 1680  RUN"MENU
  171. 1690  CLS:GOSUB 1980
  172. 1700  GOSUB 980
  173. 1710  GOSUB 970
  174. 1720  GOSUB 1090
  175. 1730  GOSUB 1080
  176. 1740  GOSUB 1040
  177. 1750  GOSUB 1000
  178. 1760  GOSUB 960
  179. 1770  GOSUB 950
  180. 1780  GOSUB 880
  181. 1790  GOSUB 810
  182. 1800  COLOR 15,0:LOCATE 6,35,0:PRINT "CALL \=/ CALL":COLOR 6,0
  183. 1810  FOR A=1 TO 12
  184. 1820     LOCATE 9,45:PRINT X$(0)
  185. 1830     LOCATE 9,32:PRINT X1$(0)
  186. 1840     LOCATE 9,45:PRINT X$(1)
  187. 1850     LOCATE 9,32:PRINT X1$(1)
  188. 1860     LOCATE 9,45:PRINT Y$(1)
  189. 1870     LOCATE 9,32:PRINT Y1$(1)
  190. 1880     LOCATE 9,45:PRINT X$(2)
  191. 1890     LOCATE 9,32:PRINT X1$(2)
  192. 1900     LOCATE 9,45:PRINT Y$(2)
  193. 1910     LOCATE 9,32:PRINT Y1$(2)
  194. 1920     LOCATE 9,45:PRINT X$(1)
  195. 1930     LOCATE 9,32:PRINT X1$(1)
  196. 1940     LOCATE 9,45:PRINT Y$(1)
  197. 1950     LOCATE 9,32:PRINT Y1$(1)
  198. 1960  GOSUB 1000:GOSUB 1040:GOSUB 1080:GOSUB 1090
  199. 1970  NEXT:LOCATE ,,1:RETURN
  200. 1980  X$(1)="WHILEWHILEWHILEWHILEWHILEWHILEWHILEWHILEWHILECSRLINCSRLINCSRLIN"
  201. 1990  Y$(1)="            "
  202. 2000  X1$(1)=STRING$(12,29)+"CSRLINCSRLINCSRLINWHILEWHILEWHILEWHILEWHILEWHILEWHILEWHILEWHILE"
  203. 2010  Y1$(1)=STRING$(12,29)+"            "
  204. 2020  W=CHR$(30)+CHR$(29)
  205. 2030  X$(2)="WHILE"+W+"WHILEWHILE"+W+"WHILEWHILE"+W+"WHILEWHILE"+W+CHR$(29)+"CSRLINCSRLINCSRLIN"
  206. 2040  Y$(2)=" "+W+"  "+W+"  "+W+"  "+W+CHR$(29)+"   "
  207. 2050  W=CHR$(30)+STRING$(3,29)
  208. 2060  X1$(2)=CHR$(29)+"WHILE"+W+" WHILEWHILE"+W+"WHILEWHILE"+W+"WHILEWHILE"+W+"CSRLINCSRLINCSRLIN"
  209. 2070  Y1$(2)=CHR$(29)+" "+W+"   "+W+"  "+W+"  "+W+CHR$(29)+"    "
  210. 2080  W=CHR$(31)+CHR$(29)
  211. 2090  X$(0)=W+"  "+W+"  "+W+"  "+W+CHR$(29)+"   "
  212. 2100  W=CHR$(31)+STRING$(4,29)+"    "
  213. 2110  X1$(0)=CHR$(28)+W+W+W+CHR$(29)+W      
  214. 2120  RETURN
  215. 2130  WH=""
  216. 2140  DEF SEG:POKE 106,0:IF INKEY$<>"" THEN 2130
  217. 2150  WI=INKEY$:IF WI="" THEN 2150
  218. 2160  IF WI=CHR$(13) THEN WA=SPACE$(LEN(WORD(B))):LSET WA=WH:RETURN
  219. 2170  IF WI=CHR$(8) THEN 2230
  220. 2180  IF LEN(WI)>1 THEN IF RIGHT$(WI,1)=CHR$(75) THEN 2230 ELSE 2150
  221. 2190  IF LEN(WH)>LEN(WORD(B)) THEN 2150
  222. 2200  IF WI<"a" OR WI>"z" THEN 2220
  223. 2210  WI=CHR$(ASC(WI)-32)
  224. 2220  WH=WH+WI:PRINT WI;:GOTO 2150
  225. 2230  IF LEN(WH)<1 THEN 2150
  226. 2240  PRINT CHR$(29)" "CHR$(29);:WH=LEFT$(WH,LEN(WH)-1):GOTO 2150
  227.